---
title: "Replication of analysis"
output: html_document
date: "2025-03-07"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE,
                      warning = FALSE, 
                      message = FALSE)
```


# Environment

```{r}
R.version.string
```



# Import Packages

```{r}
library(tidyverse)
library(patchwork)
library(knitr)
library(lme4)
library(knitr)
library(ggpubr)
library(stargazer)
```

# Data Import

```{r}

dat1 <- read_csv("data/dat_non-observe.csv")
dat2 <- read_csv("data/dat_observe.csv")

```




# Cood book


dat1

- participant.id_in_session: unique ID for a participant
- player.id_in_group : role of each player (= 1 if role A(sender), = 0 if role B(receiver))
- subsession.round_number: round number (= 1, 2, ..., 10)
- group.p_type_w : probability of unbiased advisor (0.5 or 0.8)
- group.urn_blue: whether color of pot is blue or not (= 1 if pot(urn) is blue, = 0 if red)
- group.sender_type: type of sender (= "unbiased", "red_biased", "blue_biased")
- group.num_blue: the number of blue balls observed by sender at this period (= 0, 1, 2, 3)
- group.num_red: the number of blue reds observed by sender at this period (= 0, 1, 2, 3)
- group.send_hint: the hint sent by sender (= "Blue" or "Red")
- group.send_answer: the guess chosen by receiver (= "Blue" or "Red")
- group.total_choice_red: the total number of guessing red by receiver so far
- group.total_choice_blue: the total number of guessing blue by receiver so far
- urn_color: color of urn (= 1 if pot(urn) is blue, = 0 if red)
- hint_blue: whether the hint provided by sender is blue or not (= 1 if the guess is blue, = 0 if red) 
- ans_blue: whether the guess by recevier is blue or not (= 1 if the guess is blue, = 0 if red)
- hint_blue_repeat: how long the blue hint is repeated so far
- cond: experimental conditions (= "Non-Observable" or "Observable")
- period: = subsession.round_number = round number
- cum_blue_red = cumulative number of blue balls observed - that of red balls 
- cum_hint_blue_red = cumulative number of blue hints - that of red hints
- blue_biased: whetehr advisor is type blue or not (1 = type blue advisor, 0 otherwise)
- red_biased: whetehr advisor is type red or not (1 = type red advisor, 0 otherwise)

dat2

- group.num_blue2: the number of blue ball observed by receiver at this period (= 0, 1)
- grou_num_red2: the number of red ball observed by receiver at this period (= 0, 1)
- cum_blue_red2


```{r eval = TRUE}
dat1 <- dat1 %>% select(
  participant.id_in_session,
  player.id_in_group,
  subsession.round_number,
  group.p_type_w,
  group.urn_blue,
  group.sender_type,
  group.num_blue,
  group.num_red,
  group.send_hint,
  group.send_answer,
  group.total_choice_red,
  group.total_choice_blue,
  urn_color,
  ans_blue,
  hint_blue,
  hint_blue_repeat,
  hint_num_repeat, 
  cond, 
  period, 
  cum_blue_red,
  cum_hint_blue_red,
  blue_biased,
  red_biased,
  player.switching_point50, 
  player.switching_point80, 
)
```


```{r eval = TRUE}
dat2 <- dat2 %>% select(
    participant.id_in_session,
  player.id_in_group,
  subsession.round_number,
  group.p_type_w,
  group.urn_blue,
  group.sender_type,
  group.num_blue,
  group.num_red,
  group.send_hint,
  group.send_answer,
  group.total_choice_red,
  group.total_choice_blue,
  urn_color,
  ans_blue,
  hint_blue,
  hint_blue_repeat,
  hint_num_repeat, 
  cond, 
  period, 
  cum_blue_red,
  cum_hint_blue_red,
  blue_biased,
  red_biased,
  player.switching_point50, 
  player.switching_point80, 
  group.num_blue2,
  group.num_red2,
  cum_blue_red2
)

```


# 5.1 Descriptive statistics and testing Hypothesis 1

```{r}

dat1$group.sender_type2 <- ifelse(dat1$group.sender_type == "unbiased", "unbiased", "biased")
dat2$group.sender_type2 <- ifelse(dat2$group.sender_type == "unbiased", "unbiased", "biased")

# B non-observe 条件

dat1 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w) %>% 
  summarize(
    num_pair = n()/10, 
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_correct_guess = mean(correct_guess)
  )  -> tmp1

tmp1$cond <- "Non Observable"

# B observe 条件

dat2 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w) %>% 
  summarize(
    num_pair = n()/10, 
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_correct_guess = mean(correct_guess)
  ) -> tmp2

tmp2$cond <- "Observable"

Tmp <- rbind(tmp1, tmp2)

Tmp %>% select(cond, everything()) -> Tmp

Tmp$cond2 <- 
  ifelse(Tmp$cond == "Non Observable" & Tmp$group.p_type_w == 50, "Non Observable-50", 
         ifelse(Tmp$cond == "Non Observable" & Tmp$group.p_type_w == 80, "Non Observable-80",
                ifelse(Tmp$cond == "Observable" & Tmp$group.p_type_w == 50, "Observable-50",
                       "Observable-80")))

Tmp2 <- Tmp %>% select(- cond, - group.p_type_w)
Tmp2 <- Tmp2 %>% select(cond2, everything())

colnames(Tmp2) <- c("Condition", "N. of subs.", "Follow Hint", "Correct Hint", "Correct Guess")

```

## Table 2

```{r}
Tmp2 %>% knitr::kable(digits = 3)
```


## Wilcoxon rank sum test after Table 2

```{r}
dat1 %>% filter(player.id_in_group == 1) %>% 
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_correct_guess = mean(correct_guess)
  ) %>% mutate(
    diff_guess_hint = mean_correct_guess - mean_correct_hint
  )  -> tmp1

# B observe 条件

dat2 %>%  
  filter(player.id_in_group == 1) %>% 
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_correct_guess = mean(correct_guess)
  ) %>% mutate(
    diff_guess_hint = mean_correct_guess - mean_correct_hint
  )  -> tmp2


# comparison of follow hint

wilcox.test(tmp1 %>% filter(group.p_type_w == 80) %>% pull(mean_follow_hint), 
            tmp1 %>% filter(group.p_type_w == 50) %>% pull(mean_follow_hint))
# W = 238.5, p-value = 0.6545

wilcox.test(tmp1 %>% filter(group.p_type_w == 80) %>% pull(mean_follow_hint), 
            tmp2 %>% filter(group.p_type_w == 80) %>% pull(mean_follow_hint))
# W = 241.5, p-value = 0.41

wilcox.test(tmp1 %>% filter(group.p_type_w == 80) %>% pull(mean_follow_hint), 
            tmp2 %>% filter(group.p_type_w == 50) %>% pull(mean_follow_hint))
# W = 270.5, p-value = 0.2068

wilcox.test(tmp1 %>% filter(group.p_type_w == 50) %>% pull(mean_follow_hint), 
            tmp2 %>% filter(group.p_type_w == 80) %>% pull(mean_follow_hint))
# W = 205, p-value = 0.9046

wilcox.test(tmp1 %>% filter(group.p_type_w == 50) %>% pull(mean_follow_hint), 
            tmp2 %>% filter(group.p_type_w == 50) %>% pull(mean_follow_hint))
# W = 250, p-value = 0.4596

wilcox.test(tmp2 %>% filter(group.p_type_w == 80) %>% pull(mean_follow_hint), 
            tmp2 %>% filter(group.p_type_w == 50) %>% pull(mean_follow_hint))
# W = 238, p-value = 0.4637

```

## Figure 2 and Figure 2S


```{r eval = TRUE}

# Correct Hint

dat1 %>% filter(player.id_in_group == 2, group.urn_blue == (group.send_hint == "Blue")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  )  -> tmp1

tmp1$observability <- "Non Observable"

dat2 %>% filter(player.id_in_group == 2, group.urn_blue == (group.send_hint == "Blue")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  ) -> tmp2

tmp2$observability <- "Observable"

Tmp <- rbind(tmp1, tmp2)


#compare_means(mean_follow_hint ~ cond, data = Tmp)

#compare_means(mean_follow_hint ~ cond, data = Tmp, group.by = "group.p_type_w")

p1 <- ggboxplot(Tmp, x = "group.p_type_w", y = "mean_follow_hint",
          color = "observability", palette = "jco",
          add = "jitter",
          short.panel.labs = TRUE, legend = "right", 
          title = "Hints are correct", 
          xlab = "Prob. of unbiased advisor",
          ylab = "Prob. of following hints") + ylim(0, 1.5)
# Use only p.format as label. Remove method name.
p1 <- p1 + stat_compare_means(aes(group = observability), label = "p.format", label.y = 1.25)


# Wrong Hint

dat1 %>% filter(player.id_in_group == 2, group.urn_blue == (group.send_hint == "Red")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  )  -> tmp1

tmp1$observability <- "Non Observable"

dat2 %>% filter(player.id_in_group == 2, group.urn_blue == (group.send_hint == "Red")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  ) -> tmp2

tmp2$observability <- "Observable"

Tmp <- rbind(tmp1, tmp2)


#compare_means(mean_follow_hint ~ cond, data = Tmp)

#compare_means(mean_follow_hint ~ cond, data = Tmp, group.by = "group.p_type_w")

# Box plot facetted by "dose"
p2 <- ggboxplot(Tmp, x = "group.p_type_w", y = "mean_follow_hint",
          color = "observability", palette = "jco",
          add = "jitter",
          short.panel.labs = TRUE, legend = "right", 
          title = "Hints are wrong",
          xlab = "Prob. of unbiased advisor",
          ylab = "Prob. of following hints") + ylim(0, 1.5)
# Use only p.format as label. Remove method name.
p2 <- p2 + stat_compare_means(aes(group = observability), label = "p.format", label.y = 1.25)
```


Figure 2

```{r eval=TRUE}

p1 / p2 + plot_layout(guides = "collect", ncol = 1)
```



```{r eval = TRUE}

# Correct Hint by W

dat1 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Blue")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  )  -> tmp1

tmp1$observability <- "Non Observable"

dat2 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Blue")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  ) -> tmp2

tmp2$observability <- "Observable"

Tmp <- rbind(tmp1, tmp2)

# compare_means(mean_follow_hint ~ cond, data = Tmp, group.by = "group.p_type_w")

p1w <- ggboxplot(Tmp, x = "group.p_type_w", y = "mean_follow_hint",
          color = "observability", palette = "jco",
          add = "jitter",
          short.panel.labs = TRUE, legend = "right", 
          title = "Hints are correct and advisor is unbiased", 
          xlab = "Prob. of unbiased advisor",
          ylab = "Prob. of following hints") + ylim(0, 1.5)
# Use only p.format as label. Remove method name.
p1w <- p1w + stat_compare_means(aes(group = observability), label = "p.format", label.y = 1.25)


# Wrong Hint by W

dat1 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Red")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  )  -> tmp1

tmp1$observability <- "Non Observable"

dat2 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Red")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  ) -> tmp2

tmp2$observability <- "Observable"

Tmp <- rbind(tmp1, tmp2)

#compare_means(mean_follow_hint ~ cond, data = Tmp, group.by = "group.p_type_w")

# Box plot facetted by "dose"
p2w <- ggboxplot(Tmp, x = "group.p_type_w", y = "mean_follow_hint",
          color = "observability", palette = "jco",
          add = "jitter",
          short.panel.labs = TRUE, legend = "right", 
          title = "Hints are wrong and advisor is unbiased",
          xlab = "Prob. of unbiased advisor",
          ylab = "Prob. of following hints") + ylim(0, 1.5)
# Use only p.format as label. Remove method name.
p2w <- p2w + stat_compare_means(aes(group = observability), label = "p.format", label.y = 1.25)

```


Figure 2S

```{r eval=TRUE}

p1w / p2w + plot_layout(guides = "collect", ncol = 1)
```


# 5.2. Analysis on guessers’ disobedience and testing Hypotheses 2 and 3 


## Table 3

```{r eval = TRUE, results='asis'}

dat1$low_w_dummy <- ifelse(dat1$group.p_type_w ==50, 1, 0)
dat2$low_w_dummy <- ifelse(dat2$group.p_type_w ==50, 1, 0)


dat1 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res1


dat2 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + group.num_blue2 + cum_blue_red2 + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res3

dat1 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + low_w_dummy + hint_blue_repeat:low_w_dummy + 
          subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res2

dat2 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + low_w_dummy + hint_blue_repeat:low_w_dummy + 
          group.num_blue2 + cum_blue_red2 + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res4


star <- stargazer(res1, res2, res3, res4, 
          type = "html", # please change it to "latex" if needed
          title            = "Regression results of guessers' choices",　# タイトルを入れる
          dep.var.labels   = "Guess Blue (1 = guess bule and 0 = guess red)", 
          column.labels=c("Non Observable", "Non Observable", "Observable", "Observable"),
          covariate.labels =
            c("Blue Hint",
              "Rep. Blue Hints",
              "Low Unbiased Dum. = $D_{low}$",
              "Blue Ball",
              "Cum. Blue Balls",
              "Period",
              "$\\text{Rep. Blue Hint} * D_{low}$",
              "Constant"),
          header=FALSE, 
          notes = "$D_{low} (\\text{= 1 when prob. unbiased ($p$) = 0.5 and 0 otherwise})$"
          )


```


# 5.3. Supporting evidence from guessers’ evaluation about advisors’ types


## Table 4

```{r}
# dat1
n <- nrow(dat1)
dat1$hint_num_switch <- 0

for (i in 1:n){
  if (i %% 10 != 1){
    if(dat1$group.send_hint[i] != dat1$group.send_hint[i-1]){
      dat1$hint_num_switch[i] <- dat1$hint_num_switch[i-1] + 1
    }  else {
      dat1$hint_num_switch[i] <- dat1$hint_num_switch[i-1]
    }
  }
}


dat1$hint_max_run <- 0

for (i in 1:(n/10)){
  dat1$hint_max_run[i * 10] <- max( dat1$hint_num_repeat[((i-1)* 10 + 1): (i * 10)])
}

# dat2

n <- nrow(dat2)
dat2$hint_num_switch <- 0

for (i in 1:n){
  if (i %% 10 != 1){
    if(dat2$group.send_hint[i] != dat2$group.send_hint[i-1]){
      dat2$hint_num_switch[i] <- dat2$hint_num_switch[i-1] + 1
    }  else {
      dat2$hint_num_switch[i] <- dat2$hint_num_switch[i-1]
    }
  }
}

dat2$hint_max_run <- 0

for (i in 1:(n/10)){
  dat2$hint_max_run[i * 10] <- max( dat2$hint_num_repeat[((i-1)* 10 + 1): (i * 10)])
}


dat1$white_dummy <- ifelse(dat1$group.sender_type == "unbiased", 1, 0)
dat2$white_dummy <- ifelse(dat2$group.sender_type == "unbiased", 1, 0)


dat1$white_diff <- 0
dat1$white_diff <- ifelse(dat1$group.p_type_w == 80, dat1$player.switching_point80 - 80, 0)
dat1$white_diff <- ifelse(dat1$group.p_type_w == 50, dat1$player.switching_point50 - 50, dat1$white_diff)

dat2$white_diff <- 0
dat2$white_diff <- ifelse(dat2$group.p_type_w == 80, dat2$player.switching_point80 - 80, 0)
dat2$white_diff <- ifelse(dat2$group.p_type_w == 50, dat2$player.switching_point50 - 50, dat2$white_diff)
```



```{r eval = TRUE, results='asis'}
dat1 %>% 
  filter(subsession.round_number == 10, 
         player.id_in_group == 2, 
         participant.id_in_session != 2 # コード 9999 の エラ〜の被験者への対処 => ID 2
  ) -> tmp1

dat2 %>% 
  filter(subsession.round_number == 10, 
         player.id_in_group == 2, 
         participant.id_in_session != 128 # コード 9999 の エラ〜の被験者への対処 > ID 128
  ) -> tmp2

tmp1$observe <- 0
tmp2$observe <- 1

tmp3 <- rbind(tmp1 %>% select(white_diff, hint_num_switch, white_dummy, hint_max_run, observe), 
              tmp2 %>% select(white_diff, hint_num_switch, white_dummy, hint_max_run, observe))

tmp3 %>% 
  lm(white_diff ~ hint_num_switch, data = .) -> res5

tmp3 %>% 
  lm(white_diff ~ hint_max_run, data = .) -> res6

tmp3 %>% 
  lm(white_diff ~ hint_num_switch + observe * white_dummy, data = .) -> res7

tmp3 %>% 
  lm(white_diff ~ hint_max_run + observe * white_dummy, data = .) -> res8


stargazer(res5, res6, res7, res8, 
          type = "html",
          title            = "Regression results on the guesser's evaluation regarding the unbiased advisor",
          dep.var.labels   = "Posteior minus Prior Probability",
          column.labels = c("(1)", "(2)", "(3)", "(4)"),
          model.numbers = FALSE,
          omit.stat=c("LL","ser","f"),
          covariate.labels = c("Num Hint Switch",
                               "Hint Max Run",
                               "Observable Dum. (= OD)",
                               "Unbiased Advisor Dum. (= UAD)",
                               "OD * UAD",
                               "Constant"),
          header=FALSE
          )


```




## Figure 3

```{r}

dat1 %>% 
  filter(subsession.round_number == 10, 
                player.id_in_group == 2
                ) %>% 
  mutate(
    white_dummy = ifelse(white_dummy == 1, "unbiased", "biased")
  ) %>% select(hint_num_switch, white_dummy, hint_max_run) -> tmp1

dat2 %>% 
  filter(subsession.round_number == 10, 
                player.id_in_group == 2
                ) %>% 
  mutate(
    white_dummy = ifelse(white_dummy == 1, "unbiased", "biased")
  ) %>% select(hint_num_switch, white_dummy, hint_max_run) -> tmp2

tmp3 <- rbind(tmp1, tmp2)

tmp3 %>% 
  ggplot(aes(x = hint_num_switch, fill = white_dummy)) + 
  geom_histogram(position = "dodge", alpha = 0.8) + 
  scale_fill_manual(values=c("orange", "blue")) +
  theme_minimal() +
  labs(x="Num Hint Switch", y="", fill="Advisor type") + 
  scale_x_continuous(breaks = seq(0, 8, 1), lim = c(-1, 9)) +
  annotate("text", x=1,   y=8.75, label="p = 0.30") -> p1

tmp3 %>% 
  ggplot(aes(x = hint_max_run, fill = white_dummy)) + 
  geom_histogram(position = "dodge", alpha = 0.8) + 
  scale_fill_manual(values=c("orange", "blue")) +
  theme_minimal() +
  labs(x="Hint Max Run", y="", fill="Advisor type") + 
  scale_x_continuous(breaks = seq(0, 10, 1), lim = c(-1, 11)) + 
  annotate("text", x=1,   y=8.75, label="p = 0.58") -> p2

p1 / p2 + plot_layout(guides = "collect", ncol = 1)


```



# 6. Additional study

## Data Import Study 2

```{r eval = TRUE}

d1 <- read_csv("data/dat_human.csv")
d2 <- read_csv("data/dat_ai.csv")

```


```{r eval = TRUE}
d1 <- d1 %>% select(
  participant.id_in_session,
  player.id_in_group,
  subsession.round_number,
  group.p_type_w,
  group.urn_blue,
  group.sender_type,
  group.num_blue,
  group.num_red,
  group.send_hint,
  group.send_answer,
  group.total_choice_red,
  group.total_choice_blue,
  urn_color,
  ans_blue,
  hint_blue,
  hint_blue_repeat,
  hint_num_repeat, 
  cond, 
  period, 
  cum_blue_red,
  cum_hint_blue_red
)
```


```{r eval = TRUE}
d2 <- d2 %>% select(
  participant.id_in_session,
  player.id_in_group,
  subsession.round_number,
  player.urn_blue,
  player.num_blue,
  player.send_hint,
  player.send_answer,
  urn_color,
  ans_blue,
  hint_blue,
  hint_blue_repeat,
  hint_num_repeat, 
  cond, 
  period, 
  cum_blue_red,
  cum_hint_blue_red
)


```





## Table 5

```{r}

d1 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% group_by(cond) %>% 
  summarize(
    num_pair = n()/20, 
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_coffect_guess = mean(correct_guess)
  )  -> tmp1

# AI

d2 %>% mutate(
  follow_hint = ifelse(player.send_hint == player.send_answer, 1, 0), 
  correct_hint = ifelse(player.urn_blue == (player.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == player.send_answer, 1, 0)
) %>% group_by(cond) %>% 
  summarize(
    num_pair = n()/20, 
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_coffect_guess = mean(correct_guess)
  ) -> tmp2

tmp2$cond <- "Machine (AI)"

Tmp <- rbind(tmp1, tmp2)

Tmp %>% select(cond, everything()) -> Tmp

colnames(Tmp) <- c("Condition", "N. of subs.", "Follow Hint", "Correct Hint", "Correct Guess")


Tmp %>% knitr::kable(digits = 3)
```


## Wilcoxon Rank Sum test after Table 5

```{r}

d1 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% filter(
  player.id_in_group == 1
) %>% group_by(participant.id_in_session) %>% 
  summarize(
    n = n(),
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_coffect_guess = mean(correct_guess)
  ) -> tmp1


d2 %>% mutate(
  follow_hint = ifelse(player.send_hint == player.send_answer, 1, 0), 
  correct_hint = ifelse(player.urn_blue == (player.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == player.send_answer, 1, 0)
) %>% group_by(participant.id_in_session) %>% 
  summarize(
    n = n(),
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_coffect_guess = mean(correct_guess)
  ) -> tmp2

wilcox.test(tmp1$mean_follow_hint, tmp2$mean_follow_hint)
wilcox.test(tmp1$mean_correct_hint, tmp2$mean_correct_hint)
wilcox.test(tmp1$mean_coffect_guess, tmp2$mean_coffect_guess)
```



## Table 6




```{r eval = TRUE, results='asis'}

d1 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + cum_hint_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res9


d2 %>%
  glmer(ans_blue ~ hint_blue + cum_hint_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res10


d1 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res11


d2 %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res12


stargazer(res11, res9, res12, res10, 
          type = "html", 
          title            = "Regression results of guessers’ choices against human and machine advisors",　# タイトルを入れる
          column.labels=c("Human", "Human", "Machine", "Machine"),
          model.numbers = FALSE,
          covariate.labels = c("Blue Hint",
                               "Rep. Blue Hints",
                               "Cum. Blue Hints",
                               "Period",
                               "Constant"), #独立変数の名前をいれる
          dep.var.labels   = "Guess Blue (1 = guess bule and 0 = guess red)",
          header=FALSE
          )

```



# Appendix

## Table A1


```{r eval = TRUE}
# B non-observe 条件

dat1 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, group.sender_type2) %>% 
  summarize(
    num_pair = n()/20, 
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_coffect_guess = mean(correct_guess)
  )  -> tmp1

tmp1$cond <- "Non-Observable"

# B observe 条件

dat2 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0), 
  correct_hint = ifelse(group.urn_blue == (group.send_hint == "Blue"), 1, 0), 
  correct_guess = ifelse(urn_color == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, group.sender_type2) %>% 
  summarize(
    num_pair = n()/20, 
    mean_follow_hint = mean(follow_hint), 
    mean_correct_hint = mean(correct_hint), 
    mean_coffect_guess = mean(correct_guess)
  ) -> tmp2

tmp2$cond <- "Observable"

Tmp <- rbind(tmp1, tmp2)

Tmp %>% select(cond, everything()) -> Tmp

colnames(Tmp) <- c("Cond.", "Unbiased P.",  "S. type", "N. of pair", "Follow Hint", "Correct Hint", "Correct Guess")

```


```{r}
Tmp %>% knitr::kable(digits = 3)
```



## Figure A1


```{r}

# Correct Hint by W

dat1 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Blue")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  )  -> tmp1

tmp1$observability <- "Non-Observable"

dat2 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Blue")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  ) -> tmp2

tmp2$observability <- "Observable"

Tmp <- rbind(tmp1, tmp2)

# compare_means(mean_follow_hint ~ cond, data = Tmp, group.by = "group.p_type_w")

p1w <- ggboxplot(Tmp, x = "group.p_type_w", y = "mean_follow_hint",
          color = "observability", palette = "jco",
          add = "jitter",
          short.panel.labs = TRUE, legend = "right", 
          title = "Correct hint from unbiased adviser", 
          xlab = "Prob. of unbiased adviser",
          ylab = "Prob. of following hints") + ylim(0, 1.5)

p1w <- p1w + stat_compare_means(aes(group = observability), label = "p.format", label.y = 1.25)


# Wrong Hint by W

dat1 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Red")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  )  -> tmp1

tmp1$observability <- "Non-Observable"

dat2 %>% filter(group.sender_type == "unbiased", player.id_in_group == 2, group.urn_blue == (group.send_hint == "Red")) %>%  
  mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% group_by(group.p_type_w, participant.id_in_session) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  ) -> tmp2

tmp2$observability <- "Observable"

Tmp <- rbind(tmp1, tmp2)

p2w <- ggboxplot(Tmp, x = "group.p_type_w", y = "mean_follow_hint",
          color = "observability", palette = "jco",
          add = "jitter",
          short.panel.labs = TRUE, legend = "right", 
          title = "Wrong hint from unbiased adviser",
          xlab = "Prob. of unbiased adviser",
          ylab = "Prob. of following hints") + ylim(0, 1.5)

p2w <- p2w + stat_compare_means(aes(group = observability), label = "p.format", label.y = 1.25)

```


```{r}
p1w / p2w + plot_layout(guides = "collect", ncol = 1)
```



## Figure A2


```{r}

dat1 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% select(cond, period, group.p_type_w, follow_hint) -> tmp1

dat2 %>% mutate(
  follow_hint = ifelse(group.send_hint == group.send_answer, 1, 0)
) %>% select(cond, period, group.p_type_w, follow_hint) -> tmp2

tmp3 <- rbind(tmp1, tmp2)

tmp3$cond2 <- ifelse(tmp3$cond == "Non-Observable" & tmp3$group.p_type_w == 80, "Non-Observable-80",
                     ifelse(tmp3$cond == "Non-Observable" & tmp3$group.p_type_w == 50, "Non-Observable-50",
                            ifelse(tmp3$cond == "Observable" & tmp3$group.p_type_w == 80, "Observable-80", "Observable-50")
                            )
                     )

tmp3 %>% group_by(cond2, period) %>% 
  summarize(
    mean_follow_hint = mean(follow_hint)
  ) %>% ggplot(aes(x = period, y = mean_follow_hint, color = cond2)) + 
  geom_line() + 
  ylim(0, 1) +
  labs(color = "Treatment") -> g2
  
g2
```



## Table A2


```{r results='asis'}

dat1$low_w_dummy <- ifelse(dat1$group.p_type_w ==50, 1, 0)
dat2$low_w_dummy <- ifelse(dat2$group.p_type_w ==50, 1, 0)

dat1 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + cum_hint_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res1b

dat2 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + cum_hint_blue_red + group.num_blue2 + cum_blue_red2 + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res3b

dat1 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + cum_hint_blue_red + low_w_dummy + cum_hint_blue_red:low_w_dummy + 
          subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res2b

dat2 %>% filter(player.id_in_group == 2) %>% 
  glmer(ans_blue ~ hint_blue + cum_hint_blue_red + low_w_dummy + cum_hint_blue_red:low_w_dummy + 
          group.num_blue2 + cum_blue_red2 + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res4b


stargazer(res1b, res2b, res3b, res4b,
          type = "html",
          title            = "Alternative definition of repetitive hints",
          dep.var.labels   = "Guess Blue (1 = guess bule and 0 = guess red)",
          column.labels=c("Non Observable", "Non Observable", "Observable", "Observable"),
          covariate.labels =
            c("Hint blue",
              "Cum. blue minus red hints",
              "$D_{low}$",
              "Blue ball",
              "Cum. blue minus red balls",
              "Period",
              "$\\text{Cum. blue minus red hints} * D_{low}$",
              "Constant"),
          header=FALSE,
          notes = "$D_{low} (= 1 \\text{ when prob. unbiased = 0.5})$"
          )

```



## Table A3

```{r results='asis'}

dat1$low_w_dummy <- ifelse(dat1$group.p_type_w ==50, 1, 0)
dat2$low_w_dummy <- ifelse(dat2$group.p_type_w ==50, 1, 0)

dat1 %>% filter(player.id_in_group == 2, group.sender_type == "unbiased") %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res1w

dat2 %>% filter(player.id_in_group == 2, group.sender_type == "unbiased") %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + group.num_blue2 + cum_blue_red2 + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res3w

dat1 %>% filter(player.id_in_group == 2, group.sender_type == "unbiased") %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + low_w_dummy + hint_blue_repeat:low_w_dummy + 
        subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res2w

dat2 %>% filter(player.id_in_group == 2, group.sender_type == "unbiased") %>% 
  glmer(ans_blue ~ hint_blue + hint_blue_repeat + low_w_dummy + hint_blue_repeat:low_w_dummy + 
          group.num_blue2 + cum_blue_red2 + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res4w

stargazer(res1w, res2w, res3w, res4w, 
          type = "html",
          title            = "Restricted to gussers paired with unbiased sender",　# タイトルを入れる
          dep.var.labels   = "Guess Blue (1 = guess bule and 0 = guess red)", 
          column.labels=c("Non Observe", "Non Observe", "Observe", "Observe"),
          covariate.labels = 
            c("Hint blue", 
              "Hint blue repeat", 
              "$D_{low}$",
              "Blue ball", 
              "Cum. blue minus red balls", 
              "Period",
              "$\\text{hint blue repeat} * D_{low}$",
              "Constant"),
          header=FALSE,
          notes = "$D_{low} (= 1 \\text{ when prob. unbiased = 0.5})$"
          )

```



## Table A4



```{r eval =TRUE, results='asis'}

# sender (A) 側の分析。

# non-observe. sender (A) 側の分析。

dat1 %>% filter(player.id_in_group == 1) %>% 
  glmer(hint_blue ~ group.num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res1

dat1 %>% filter(player.id_in_group == 1) %>% 
  glmer(hint_blue ~ blue_biased + red_biased + group.num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res2

dat1 %>% filter(player.id_in_group == 1, group.sender_type == "unbiased") %>% 
  glmer(hint_blue ~ group.num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), data = ., family = binomial) -> res3


# observe. sender (A) 側の分析。

dat2 %>% filter(player.id_in_group == 1) %>% 
  glmer(hint_blue ~ group.num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res4

dat2 %>% filter(player.id_in_group == 1) %>% 
  glmer(hint_blue ~ blue_biased + red_biased + group.num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res5
  
dat2 %>% filter(player.id_in_group == 1, group.sender_type == "unbiased") %>% 
  glmer(hint_blue ~ group.num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), data = ., family = binomial) -> res6

# tab_model(res1, res2, res3, transform = NULL,
#           dv.labels = c("hint_blue (all)", 
#               "hint_blue (all)",
#               "hint_blue (white)"))

# tab_model(res1, res2, res3, transform = NULL, 
#           dv.labels = c("hint_blue (all)", 
#                         "hint_blue (all)",
#                         "hint_blue (white)"))

stargazer(res2, res3, res5, res6, 
          type = "html",
          title            = "Regression analysis on advisers' behavior",
          dep.var.labels   = "Hint Blue by Adviser",
          column.labels=c("NO", "NO (unbiased)", "O", "O (unbiased)"),
          omit.stat=c("f"),
          covariate.labels = c("Blue biased adviser", 
                               "Red biased adviser", 
                               "Num blue ball",
                               "Cum. blue minus red balls",
                               "Period",
                               "Constant"),
          header=FALSE,
          notes = "NO and O imply Non-Observe and Observe, respectively"
          )

```


## Table A5



```{r eval =TRUE, results='asis'}

# Study 2

# sender (A) 側の分析。

# Human

d1 %>% filter(player.id_in_group == 1) %>% 
  mutate(num_blue = group.num_blue) %>% 
  glmer(hint_blue ~ num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res1


# AI

d2 %>% 
  mutate(num_blue = player.num_blue) %>% 
  glmer(hint_blue ~ num_blue + cum_blue_red + subsession.round_number + (1|participant.id_in_session), 
        data = ., family = binomial) -> res2


stargazer(res1, res2, 
          type = "html",
          title = "Human Adviser vs Machine Adviser",
          dep.var.labels   = "Hint Blue by Adviser",
          column.labels=c("Human", "Machine"),
          omit.stat=c("f"),
          header=FALSE,
          covariate.labels = c(
                     "Num blue ball",
                     "Cum. blue minus red balls",
                     "Period",
                     "Constant")
          )

```


